home *** CD-ROM | disk | FTP | other *** search
- /*
- * tclUnixUtil.c --
- *
- * This file contains a collection of utility procedures that
- * are present in the Tcl's UNIX core but not in the generic
- * core. For example, they do file manipulation and process
- * manipulation.
- *
- * The Tcl_Fork and Tcl_WaitPids procedures are based on code
- * contributed by Karl Lehenbauer, Mark Diekhans and Peter
- * da Silva.
- *
- * Copyright 1991 Regents of the University of California
- * Permission to use, copy, modify, and distribute this
- * software and its documentation for any purpose and without
- * fee is hereby granted, provided that this copyright
- * notice appears in all copies. The University of California
- * makes no representations about the suitability of this
- * software for any purpose. It is provided "as is" without
- * express or implied warranty.
- */
-
- #ifndef lint
- static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.18 91/11/21 14:53:46 ouster Exp $ SPRITE (Berkeley)";
- #endif /* not lint */
-
- #include "tclInt.h"
- #include "tclUnix.h"
-
- /*
- * Data structures of the following type are used by Tcl_Fork and
- * Tcl_WaitPids to keep track of child processes.
- */
-
- typedef struct {
- int pid; /* Process id of child. */
- WAIT_STATUS_TYPE status; /* Status returned when child exited or
- * suspended. */
- int flags; /* Various flag bits; see below for
- * definitions. */
- } WaitInfo;
-
- /*
- * Flag bits in WaitInfo structures:
- *
- * WI_READY - Non-zero means process has exited or
- * suspended since it was forked or last
- * returned by Tcl_WaitPids.
- * WI_DETACHED - Non-zero means no-one cares about the
- * process anymore. Ignore it until it
- * exits, then forget about it.
- */
-
- #define WI_READY 1
- #define WI_DETACHED 2
-
- static WaitInfo *waitTable = NULL;
- static int waitTableSize = 0; /* Total number of entries available in
- * waitTable. */
- static int waitTableUsed = 0; /* Number of entries in waitTable that
- * are actually in use right now. Active
- * entries are always at the beginning
- * of the table. */
- #define WAIT_TABLE_GROW_BY 4
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalFile --
- *
- * Read in a file and process the entire file as one gigantic
- * Tcl command.
- *
- * Results:
- * A standard Tcl result, which is either the result of executing
- * the file or an error indicating why the file couldn't be read.
- *
- * Side effects:
- * Depends on the commands in the file.
- *
- *----------------------------------------------------------------------
- */
-
- int
- Tcl_EvalFile(interp, fileName)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- char *fileName; /* Name of file to process. Tilde-substitution
- * will be performed on this name. */
- {
- int fileId, result;
- struct stat statBuf;
- char *cmdBuffer, *end, *oldScriptFile;
- Interp *iPtr = (Interp *) interp;
-
- oldScriptFile = iPtr->scriptFile;
- iPtr->scriptFile = fileName;
- fileName = Tcl_TildeSubst(interp, fileName);
- if (fileName == NULL) {
- goto error;
- }
- fileId = open(fileName, O_RDONLY, 0);
- if (fileId < 0) {
- Tcl_AppendResult(interp, "couldn't read file \"", fileName,
- "\": ", Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- if (fstat(fileId, &statBuf) == -1) {
- Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
- "\": ", Tcl_UnixError(interp), (char *) NULL);
- close(fileId);
- goto error;
- }
- cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
- if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
- Tcl_AppendResult(interp, "error in reading file \"", fileName,
- "\": ", Tcl_UnixError(interp), (char *) NULL);
- close(fileId);
- goto error;
- }
- if (close(fileId) != 0) {
- Tcl_AppendResult(interp, "error closing file \"", fileName,
- "\": ", Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- cmdBuffer[statBuf.st_size] = 0;
- result = Tcl_Eval(interp, cmdBuffer, 0, &end);
- if (result == TCL_RETURN) {
- result = TCL_OK;
- }
- if (result == TCL_ERROR) {
- char msg[200];
-
- /*
- * Record information telling where the error occurred.
- */
-
- sprintf(msg, "\n (file \"%.150s\" line %d)", fileName,
- interp->errorLine);
- Tcl_AddErrorInfo(interp, msg);
- }
- ckfree(cmdBuffer);
- iPtr->scriptFile = oldScriptFile;
- return result;
-
- error:
- iPtr->scriptFile = oldScriptFile;
- return TCL_ERROR;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Fork --
- *
- * Create a new process using the vfork system call, and keep
- * track of it for "safe" waiting with Tcl_WaitPids.
- *
- * Results:
- * The return value is the value returned by the vfork system
- * call (0 means child, > 0 means parent (value is child id),
- * < 0 means error).
- *
- * Side effects:
- * A new process is created, and an entry is added to an internal
- * table of child processes if the process is created successfully.
- *
- *----------------------------------------------------------------------
- */
-
- int
- Tcl_Fork()
- {
- WaitInfo *waitPtr;
- pid_t pid;
-
- /*
- * Disable SIGPIPE signals: if they were allowed, this process
- * might go away unexpectedly if children misbehave. This code
- * can potentially interfere with other application code that
- * expects to handle SIGPIPEs; what's really needed is an
- * arbiter for signals to allow them to be "shared".
- */
-
- if (waitTable == NULL) {
- (void) signal(SIGPIPE, SIG_IGN);
- }
-
- /*
- * Enlarge the wait table if there isn't enough space for a new
- * entry.
- */
-
- if (waitTableUsed == waitTableSize) {
- int newSize;
- WaitInfo *newWaitTable;
-
- newSize = waitTableSize + WAIT_TABLE_GROW_BY;
- newWaitTable = (WaitInfo *) ckalloc((unsigned)
- (newSize * sizeof(WaitInfo)));
- memcpy((VOID *) newWaitTable, (VOID *) waitTable,
- (waitTableSize * sizeof(WaitInfo)));
- if (waitTable != NULL) {
- ckfree((char *) waitTable);
- }
- waitTable = newWaitTable;
- waitTableSize = newSize;
- }
-
- /*
- * Make a new process and enter it into the table if the fork
- * is successful.
- */
-
- waitPtr = &waitTable[waitTableUsed];
- pid = fork();
- if (pid > 0) {
- waitPtr->pid = pid;
- waitPtr->flags = 0;
- waitTableUsed++;
- }
- return pid;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitPids --
- *
- * This procedure is used to wait for one or more processes created
- * by Tcl_Fork to exit or suspend. It records information about
- * all processes that exit or suspend, even those not waited for,
- * so that later waits for them will be able to get the status
- * information.
- *
- * Results:
- * -1 is returned if there is an error in the wait kernel call.
- * Otherwise the pid of an exited/suspended process from *pidPtr
- * is returned and *statusPtr is set to the status value returned
- * by the wait kernel call.
- *
- * Side effects:
- * Doesn't return until one of the pids at *pidPtr exits or suspends.
- *
- *----------------------------------------------------------------------
- */
-
- int
- Tcl_WaitPids(numPids, pidPtr, statusPtr)
- int numPids; /* Number of pids to wait on: gives size
- * of array pointed to by pidPtr. */
- int *pidPtr; /* Pids to wait on: return when one of
- * these processes exits or suspends. */
- int *statusPtr; /* Wait status is returned here. */
- {
- int i, count, pid;
- register WaitInfo *waitPtr;
- int anyProcesses;
- WAIT_STATUS_TYPE status;
-
- while (1) {
- /*
- * Scan the table of child processes to see if one of the
- * specified children has already exited or suspended. If so,
- * remove it from the table and return its status.
- */
-
- anyProcesses = 0;
- for (waitPtr = waitTable, count = waitTableUsed;
- count > 0; waitPtr++, count--) {
- for (i = 0; i < numPids; i++) {
- if (pidPtr[i] != waitPtr->pid) {
- continue;
- }
- anyProcesses = 1;
- if (waitPtr->flags & WI_READY) {
- *statusPtr = *((int *) &waitPtr->status);
- pid = waitPtr->pid;
- if (WIFEXITED(waitPtr->status)
- || WIFSIGNALED(waitPtr->status)) {
- *waitPtr = waitTable[waitTableUsed-1];
- waitTableUsed--;
- } else {
- waitPtr->flags &= ~WI_READY;
- }
- return pid;
- }
- }
- }
-
- /*
- * Make sure that the caller at least specified one valid
- * process to wait for.
- */
-
- if (!anyProcesses) {
- errno = ECHILD;
- return -1;
- }
-
- /*
- * Wait for a process to exit or suspend, then update its
- * entry in the table and go back to the beginning of the
- * loop to see if it's one of the desired processes.
- */
-
- pid = wait(&status);
- if (pid < 0) {
- return pid;
- }
- for (waitPtr = waitTable, count = waitTableUsed; ;
- waitPtr++, count--) {
- if (count == 0) {
- break; /* Ignore unknown processes. */
- }
- if (pid != waitPtr->pid) {
- continue;
- }
-
- /*
- * If the process has been detached, then ignore anything
- * other than an exit, and drop the entry on exit.
- */
-
- if (waitPtr->flags & WI_DETACHED) {
- if (WIFEXITED(status) || WIFSIGNALED(status)) {
- *waitPtr = waitTable[waitTableUsed-1];
- waitTableUsed--;
- }
- } else {
- waitPtr->status = status;
- waitPtr->flags |= WI_READY;
- }
- break;
- }
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_DetachPids --
- *
- * This procedure is called to indicate that one or more child
- * processes have been placed in background and are no longer
- * cared about. They should be ignored in future calls to
- * Tcl_WaitPids.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- void
- Tcl_DetachPids(numPids, pidPtr)
- int numPids; /* Number of pids to detach: gives size
- * of array pointed to by pidPtr. */
- int *pidPtr; /* Array of pids to detach: must have
- * been created by Tcl_Fork. */
- {
- register WaitInfo *waitPtr;
- int i, count, pid;
-
- for (i = 0; i < numPids; i++) {
- pid = pidPtr[i];
- for (waitPtr = waitTable, count = waitTableUsed;
- count > 0; waitPtr++, count--) {
- if (pid != waitPtr->pid) {
- continue;
- }
-
- /*
- * If the process has already exited then destroy its
- * table entry now.
- */
-
- if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
- || WIFSIGNALED(waitPtr->status))) {
- *waitPtr = waitTable[waitTableUsed-1];
- waitTableUsed--;
- } else {
- waitPtr->flags |= WI_DETACHED;
- }
- goto nextPid;
- }
- panic("Tcl_Detach couldn't find process");
-
- nextPid:
- continue;
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CreatePipeline --
- *
- * Given an argc/argv array, instantiate a pipeline of processes
- * as described by the argv.
- *
- * Results:
- * The return value is a count of the number of new processes
- * created, or -1 if an error occurred while creating the pipeline.
- * *pidArrayPtr is filled in with the address of a dynamically
- * allocated array giving the ids of all of the processes. It
- * is up to the caller to free this array when it isn't needed
- * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
- * with the file id for the input pipe for the pipeline (if any):
- * the caller must eventually close this file. If outPipePtr
- * isn't NULL, then *outPipePtr is filled in with the file id
- * for the output pipe from the pipeline: the caller must close
- * this file. If errFilePtr isn't NULL, then *errFilePtr is filled
- * with a file id that may be used to read error output after the
- * pipeline completes.
- *
- * Side effects:
- * Processes and pipes are created.
- *
- *----------------------------------------------------------------------
- */
-
- int
- Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
- outPipePtr, errFilePtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- int argc; /* Number of entries in argv. */
- char **argv; /* Array of strings describing commands in
- * pipeline plus I/O redirection with <,
- * <<, and >. Argv[argc] must be NULL. */
- int **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with
- * address of array of pids for processes
- * in pipeline (first pid is first process
- * in pipeline). */
- int *inPipePtr; /* If non-NULL, input to the pipeline comes
- * from a pipe (unless overridden by
- * redirection in the command). The file
- * id with which to write to this pipe is
- * stored at *inPipePtr. -1 means command
- * specified its own input source. */
- int *outPipePtr; /* If non-NULL, output to the pipeline goes
- * to a pipe, unless overriden by redirection
- * in the command. The file id with which to
- * read frome this pipe is stored at
- * *outPipePtr. -1 means command specified
- * its own output sink. */
- int *errFilePtr; /* If non-NULL, all stderr output from the
- * pipeline will go to a temporary file
- * created here, and a descriptor to read
- * the file will be left at *errFilePtr.
- * The file will be removed already, so
- * closing this descriptor will be the end
- * of the file. If this is NULL, then
- * all stderr output goes to our stderr. */
- {
- int *pidPtr = NULL; /* Points to malloc-ed array holding all
- * the pids of child processes. */
- int numPids = 0; /* Actual number of processes that exist
- * at *pidPtr right now. */
- int cmdCount; /* Count of number of distinct commands
- * found in argc/argv. */
- char *input = NULL; /* Describes input for pipeline, depending
- * on "inputFile". NULL means take input
- * from stdin/pipe. */
- int inputFile = 0; /* Non-zero means input is name of input
- * file. Zero means input holds actual
- * text to be input to command. */
- char *output = NULL; /* Holds name of output file to pipe to,
- * or NULL if output goes to stdout/pipe. */
- int inputId = -1; /* Readable file id input to current command in
- * pipeline (could be file or pipe). -1
- * means use stdin. */
- int outputId = -1; /* Writable file id for output from current
- * command in pipeline (could be file or pipe).
- * -1 means use stdout. */
- int errorId = -1; /* Writable file id for all standard error
- * output from all commands in pipeline. -1
- * means use stderr. */
- int lastOutputId = -1; /* Write file id for output from last command
- * in pipeline (could be file or pipe).
- * -1 means use stdout. */
- int pipeIds[2]; /* File ids for pipe that's being created. */
- int firstArg, lastArg; /* Indexes of first and last arguments in
- * current command. */
- int lastBar;
- char *execName;
- int i, j, pid;
-
- if (inPipePtr != NULL) {
- *inPipePtr = -1;
- }
- if (outPipePtr != NULL) {
- *outPipePtr = -1;
- }
- if (errFilePtr != NULL) {
- *errFilePtr = -1;
- }
- pipeIds[0] = pipeIds[1] = -1;
-
- /*
- * First, scan through all the arguments to figure out the structure
- * of the pipeline. Count the number of distinct processes (it's the
- * number of "|" arguments). If there are "<", "<<", or ">" arguments
- * then make note of input and output redirection and remove these
- * arguments and the arguments that follow them.
- */
-
- cmdCount = 1;
- lastBar = -1;
- for (i = 0; i < argc; i++) {
- if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
- if ((i == (lastBar+1)) || (i == (argc-1))) {
- interp->result = "illegal use of | in command";
- return -1;
- }
- lastBar = i;
- cmdCount++;
- continue;
- } else if (argv[i][0] == '<') {
- if (argv[i][1] == 0) {
- input = argv[i+1];
- inputFile = 1;
- } else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
- input = argv[i+1];
- inputFile = 0;
- } else {
- continue;
- }
- } else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
- output = argv[i+1];
- } else {
- continue;
- }
- if (i >= (argc-1)) {
- Tcl_AppendResult(interp, "can't specify \"", argv[i],
- "\" as last word in command", (char *) NULL);
- return -1;
- }
- for (j = i+2; j < argc; j++) {
- argv[j-2] = argv[j];
- }
- argc -= 2;
- i--; /* Process new arg from same position. */
- }
- if (argc == 0) {
- interp->result = "didn't specify command to execute";
- return -1;
- }
-
- /*
- * Set up the redirected input source for the pipeline, if
- * so requested.
- */
-
- if (input != NULL) {
- if (!inputFile) {
- /*
- * Immediate data in command. Create temporary file and
- * put data into file.
- */
-
- # define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
- char inName[sizeof(TMP_STDIN_NAME) + 1];
- int length;
-
- strcpy(inName, TMP_STDIN_NAME);
- mktemp(inName);
- inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
- if (inputId < 0) {
- Tcl_AppendResult(interp,
- "couldn't create input file for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- length = strlen(input);
- if (write(inputId, input, length) != length) {
- Tcl_AppendResult(interp,
- "couldn't write file input for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
- Tcl_AppendResult(interp,
- "couldn't reset or remove input file for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- } else {
- /*
- * File redirection. Just open the file.
- */
-
- inputId = open(input, O_RDONLY, 0);
- if (inputId < 0) {
- Tcl_AppendResult(interp,
- "couldn't read file \"", input, "\": ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- }
- } else if (inPipePtr != NULL) {
- if (pipe(pipeIds) != 0) {
- Tcl_AppendResult(interp,
- "couldn't create input pipe for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- inputId = pipeIds[0];
- *inPipePtr = pipeIds[1];
- pipeIds[0] = pipeIds[1] = -1;
- }
-
- /*
- * Set up the redirected output sink for the pipeline from one
- * of two places, if requested.
- */
-
- if (output != NULL) {
- /*
- * Output is to go to a file.
- */
-
- lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
- if (lastOutputId < 0) {
- Tcl_AppendResult(interp,
- "couldn't write file \"", output, "\": ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- } else if (outPipePtr != NULL) {
- /*
- * Output is to go to a pipe.
- */
-
- if (pipe(pipeIds) != 0) {
- Tcl_AppendResult(interp,
- "couldn't create output pipe: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- lastOutputId = pipeIds[1];
- *outPipePtr = pipeIds[0];
- pipeIds[0] = pipeIds[1] = -1;
- }
-
- /*
- * Set up the standard error output sink for the pipeline, if
- * requested. Use a temporary file which is opened, then deleted.
- * Could potentially just use pipe, but if it filled up it could
- * cause the pipeline to deadlock: we'd be waiting for processes
- * to complete before reading stderr, and processes couldn't complete
- * because stderr was backed up.
- */
-
- if (errFilePtr != NULL) {
- # define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
- char errName[sizeof(TMP_STDERR_NAME) + 1];
-
- strcpy(errName, TMP_STDERR_NAME);
- mktemp(errName);
- errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
- if (errorId < 0) {
- errFileError:
- Tcl_AppendResult(interp,
- "couldn't create error file for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- *errFilePtr = open(errName, O_RDONLY, 0);
- if (*errFilePtr < 0) {
- goto errFileError;
- }
- if (unlink(errName) == -1) {
- Tcl_AppendResult(interp,
- "couldn't remove error file for command: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- }
-
- /*
- * Scan through the argc array, forking off a process for each
- * group of arguments between "|" arguments.
- */
-
- pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
- for (i = 0; i < numPids; i++) {
- pidPtr[i] = -1;
- }
- for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
- for (lastArg = firstArg; lastArg < argc; lastArg++) {
- if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
- break;
- }
- }
- argv[lastArg] = NULL;
- if (lastArg == argc) {
- outputId = lastOutputId;
- } else {
- if (pipe(pipeIds) != 0) {
- Tcl_AppendResult(interp, "couldn't create pipe: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- outputId = pipeIds[1];
- }
- execName = Tcl_TildeSubst(interp, argv[firstArg]);
- pid = Tcl_Fork();
- if (pid == -1) {
- Tcl_AppendResult(interp, "couldn't fork child process: ",
- Tcl_UnixError(interp), (char *) NULL);
- goto error;
- }
- if (pid == 0) {
- char errSpace[200];
-
- if (((inputId != -1) && (dup2(inputId, 0) == -1))
- || ((outputId != -1) && (dup2(outputId, 1) == -1))
- || ((errorId != -1) && (dup2(errorId, 2) == -1))) {
- char *err;
- err = "forked process couldn't set up input/output\n";
- write(errorId < 0 ? 2 : errorId, err, strlen(err));
- _exit(1);
- }
- for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
- i++) {
- close(i);
- }
- execvp(execName, &argv[firstArg]);
- sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
- argv[firstArg]);
- write(2, errSpace, strlen(errSpace));
- _exit(1);
- } else {
- pidPtr[numPids] = pid;
- }
-
- /*
- * Close off our copies of file descriptors that were set up for
- * this child, then set up the input for the next child.
- */
-
- if (inputId != -1) {
- close(inputId);
- }
- if (outputId != -1) {
- close(outputId);
- }
- inputId = pipeIds[0];
- pipeIds[0] = pipeIds[1] = -1;
- }
- *pidArrayPtr = pidPtr;
-
- /*
- * All done. Cleanup open files lying around and then return.
- */
-
- cleanup:
- if (inputId != -1) {
- close(inputId);
- }
- if (lastOutputId != -1) {
- close(lastOutputId);
- }
- if (errorId != -1) {
- close(errorId);
- }
- return numPids;
-
- /*
- * An error occurred. There could have been extra files open, such
- * as pipes between children. Clean them all up. Detach any child
- * processes that have been created.
- */
-
- error:
- if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
- close(*inPipePtr);
- *inPipePtr = -1;
- }
- if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
- close(*outPipePtr);
- *outPipePtr = -1;
- }
- if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
- close(*errFilePtr);
- *errFilePtr = -1;
- }
- if (pipeIds[0] != -1) {
- close(pipeIds[0]);
- }
- if (pipeIds[1] != -1) {
- close(pipeIds[1]);
- }
- if (pidPtr != NULL) {
- for (i = 0; i < numPids; i++) {
- if (pidPtr[i] != -1) {
- Tcl_DetachPids(1, &pidPtr[i]);
- }
- }
- ckfree((char *) pidPtr);
- }
- numPids = -1;
- goto cleanup;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_UnixError --
- *
- * This procedure is typically called after UNIX kernel calls
- * return errors. It stores machine-readable information about
- * the error in $errorCode returns an information string for
- * the caller's use.
- *
- * Results:
- * The return value is a human-readable string describing the
- * error, as returned by strerror.
- *
- * Side effects:
- * The global variable $errorCode is reset.
- *
- *----------------------------------------------------------------------
- */
-
- char *
- Tcl_UnixError(interp)
- Tcl_Interp *interp; /* Interpreter whose $errorCode variable
- * is to be changed. */
- {
- char *id, *msg;
-
- id = Tcl_ErrnoId();
- msg = strerror(errno);
- Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
- return msg;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * TclMakeFileTable --
- *
- * Create or enlarge the file table for the interpreter, so that
- * there is room for a given index.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The file table for iPtr will be created if it doesn't exist
- * (and entries will be added for stdin, stdout, and stderr).
- * If it already exists, then it will be grown if necessary.
- *
- *----------------------------------------------------------------------
- */
-
- void
- TclMakeFileTable(iPtr, index)
- Interp *iPtr; /* Interpreter whose table of files is
- * to be manipulated. */
- int index; /* Make sure table is large enough to
- * hold at least this index. */
- {
- /*
- * If the table doesn't even exist, then create it and initialize
- * entries for standard files.
- */
-
- if (iPtr->numFiles == 0) {
- OpenFile *filePtr;
- int i;
-
- if (index < 2) {
- iPtr->numFiles = 3;
- } else {
- iPtr->numFiles = index+1;
- }
- iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
- ((iPtr->numFiles)*sizeof(OpenFile *)));
- for (i = iPtr->numFiles-1; i >= 0; i--) {
- iPtr->filePtrArray[i] = NULL;
- }
-
- filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
- filePtr->f = stdin;
- filePtr->f2 = NULL;
- filePtr->readable = 1;
- filePtr->writable = 0;
- filePtr->numPids = 0;
- filePtr->pidPtr = NULL;
- filePtr->errorId = -1;
- iPtr->filePtrArray[0] = filePtr;
-
- filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
- filePtr->f = stdout;
- filePtr->f2 = NULL;
- filePtr->readable = 0;
- filePtr->writable = 1;
- filePtr->numPids = 0;
- filePtr->pidPtr = NULL;
- filePtr->errorId = -1;
- iPtr->filePtrArray[1] = filePtr;
-
- filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
- filePtr->f = stderr;
- filePtr->f2 = NULL;
- filePtr->readable = 0;
- filePtr->writable = 1;
- filePtr->numPids = 0;
- filePtr->pidPtr = NULL;
- filePtr->errorId = -1;
- iPtr->filePtrArray[2] = filePtr;
- } else if (index >= iPtr->numFiles) {
- int newSize;
- OpenFile **newPtrArray;
- int i;
-
- newSize = index+1;
- newPtrArray = (OpenFile **) ckalloc((unsigned)
- ((newSize)*sizeof(OpenFile *)));
- memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
- iPtr->numFiles*sizeof(OpenFile *));
- for (i = iPtr->numFiles; i < newSize; i++) {
- newPtrArray[i] = NULL;
- }
- ckfree((char *) iPtr->filePtrArray);
- iPtr->numFiles = newSize;
- iPtr->filePtrArray = newPtrArray;
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * TclGetOpenFile --
- *
- * Given a string identifier for an open file, find the corresponding
- * open file structure, if there is one.
- *
- * Results:
- * A standard Tcl return value. If the open file is successfully
- * located, *filePtrPtr is modified to point to its structure.
- * If TCL_ERROR is returned then interp->result contains an error
- * message.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- int
- TclGetOpenFile(interp, string, filePtrPtr)
- Tcl_Interp *interp; /* Interpreter in which to find file. */
- char *string; /* String that identifies file. */
- OpenFile **filePtrPtr; /* Address of word in which to store pointer
- * to structure about open file. */
- {
- int fd = 0; /* Initial value needed only to stop compiler
- * warnings. */
- Interp *iPtr = (Interp *) interp;
-
- if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
- & (string[3] == 'e')) {
- char *end;
-
- fd = strtoul(string+4, &end, 10);
- if ((end == string+4) || (*end != 0)) {
- goto badId;
- }
- } else if ((string[0] == 's') && (string[1] == 't')
- && (string[2] == 'd')) {
- if (strcmp(string+3, "in") == 0) {
- fd = 0;
- } else if (strcmp(string+3, "out") == 0) {
- fd = 1;
- } else if (strcmp(string+3, "err") == 0) {
- fd = 2;
- } else {
- goto badId;
- }
- } else {
- badId:
- Tcl_AppendResult(interp, "bad file identifier \"", string,
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (fd >= iPtr->numFiles) {
- if ((iPtr->numFiles == 0) && (fd <= 2)) {
- TclMakeFileTable(iPtr, fd);
- } else {
- notOpen:
- Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
- (char *) NULL);
- return TCL_ERROR;
- }
- }
- if (iPtr->filePtrArray[fd] == NULL) {
- goto notOpen;
- }
- *filePtrPtr = iPtr->filePtrArray[fd];
- return TCL_OK;
- }
-